COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 TRACE UNTRACE 
C00005 ENDMK
C⊗;
; TRACE UNTRACE ;

(DF TRACE (%F ;; %X %Y)
  (MAPC %F '(LAMBDA (%F)
   (IF (MEMQ (TYPEFN %F) '(SUBR FSUBR))
	(LESCAPE (STATUS 28 %F)))
   (SETQ %X (COND ((SETQ %Y (GET %F EXPR)) EXPR)
                  ((SETQ %Y (GET %F FEXPR)) FEXPR)))
   (PUT %F %Y 'TRACE)
   (PUT %F [LAMBDA (CADR %Y)
            (CONS 'PTRAC (CONS [QUOTE %F]
                               (IF (LISTP (CADR %Y)) (CADR %Y)
                                   (CONS (CADR %Y)) ) )) ]
       %X)
   ))
  %F)

(DE PTRAC (%F . %L)  ;%F = FUNC NAME ;
  (PRINT '-----/> %F '/ /  %L)  ;%L = (VALA1 VALA2 ... VALAN) ;
  (SETQ %X (EPROGN (CDDR (GET %F 'TRACE))))
  (PRINT '/<----- %F '/ /  %X))

(DF UNTRACE (%F)
  (MAPC %F '(LAMBDA (%F)
   (IF (MEMQ (TYPEFN %F) '(SUBR FSUBR))
	(LESCAPE (STATUS 29 %F)))
   (PUT %F (GET %F 'TRACE) (IF (GET %F EXPR) EXPR FEXPR))
   (REMPROP %F 'TRACE)))
  %F)

(DE %TRTF (%X2 %X1)
   (MAPC %L '(LAMBDA (%L)
      (%RPL %X1 %X2 (CDR %L)))))
(DE %RPL (%X %Y %L)
   (WHILE (LISTP %L)(COND
      ((LISTP (CAR %L))(%RPL %X %Y (CAR %L)))
      ((EQ (CAR %L) %X) (RPLACA %L %Y)))
           (NEXTL %L)))
(DF TRACEQ (%L)(%TRTF '%TSETQ 'SETQ))
(DF UNTRACQ (%L)(%TRTF 'SETQ '%TSETQ))
(DF TRACEGO (%L)(%TRTF '%TGO 'GO))
(DF UNTRACG (%L)(%TRTF 'GO '%TGO))
(DF %TSETQ (%L)(SET(PRIN1(CAR %L))(PROGN
      (PRIN1 '/=)(PRINT(EVAL(CADR %L))))))
(DF %TGO(%L)(PRINT(CONS 'ETIQ/: %L))(GOTO(CAR %L)))
()